home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / TPRCDR10 / FD.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-26  |  7KB  |  222 lines
  1. { **************************************************************
  2.   * Programmer: Tony Papadimitriou                             *
  3.   * Program   : FD (FileDate)                                  *
  4.   * Uses      : Dos,TPRecDir,TPUtils                           *
  5.   * Includes  : Nothing                                        *
  6.   * Links     : Nothing                                        *
  7.   * Created   : Monday, August  3, 1992  6:26 pm               *
  8.   * Updated   : Saturday, December 25, 1993 12:39 pm           *
  9.   * Language  : (MSDOS) Turbo Pascal 6.0                       *
  10.   * Purpose   : Display the path of all files with the given   *
  11.   *           : date range (or today's date if none given)     *
  12.   * -------------------- Version History --------------------- *
  13.   * 1.00 920803: Original                                      *
  14.   * 1.10 930624: Added commands for >= and <= date searches    *
  15.   * 1.20 931204: Allowed forward slashes in path specification *
  16.   * 1.30 931225: Replaced core routine with TPRecDir module    *
  17.   *            : Added date display and changed output a bit   *
  18.   ************************************************************** }
  19. program FD;
  20. uses
  21.   {$ifdef VER60} {$ifopt G+} CPU286, {$endif} {$endif}
  22.   Dos,
  23.   TPRecDir,
  24.   TPUtils;
  25.  
  26. const
  27.   progName = 'FD';
  28.   version  = '1.30';
  29.  
  30. { **************************************************************
  31.   * Routine   : DisplayCopyright                               *
  32.   * Purpose   : Display the program's copyright message        *
  33.   ************************************************************** }
  34. procedure DisplayCopyright;
  35. begin
  36.   Writeln(stderr);
  37.   Writeln(stderr,progName+' ver. '+version+' ■ Copyright (c) 1992-1994 by Tony G. Papadimitriou');
  38.   Writeln(stderr);
  39. end; { DisplayCopyright }
  40.  
  41. function GetDrive(s:string): Integer;
  42. var
  43.   drive: Integer;
  44. begin
  45.      if (Length(s) >= 2) and (s[2] = ':') then
  46.        case s[1] of
  47.          'A'..'Z': drive := Ord(s[1]) - Ord('A') + 1;
  48.          'a'..'z': drive := Ord(s[1]) - Ord('a') + 1;
  49.        end { case }
  50.      else
  51.        drive := 0; { none found, use default }
  52.      GetDrive := drive;
  53. end; { GetDrive }
  54.  
  55. procedure CheckArgs;
  56. begin
  57.   if ParamCount = 0 then
  58.   begin
  59.     Writeln(stderr,'Usage: '+progName+' [<path>\]<mask>[;<mask>] [mm/dd/yy] [+|-]');
  60.     Writeln(stderr,'       Find files matching given mask and date in all dirs under one specified');
  61.     Writeln(stderr,'       ■ if date is left blank, today''s system date is used');
  62.     Writeln(stderr,'       ■ if date is followed by a + all files with a date >= the one given');
  63.     Writeln(stderr,'         will be displayed.  Similarly,');
  64.     Writeln(stderr,'       ■ if date is followed by a - all files with a date <= the one given');
  65.     Writeln(stderr,'         will be displayed.');
  66.     Writeln(stderr);
  67.     Writeln(stderr,'       Press ESC during search to interrupt prematurely.');
  68.     Halt(1);
  69.   end; { if }
  70. end; { CheckArgs }
  71.  
  72. function ShowDate(dt: Longint): String;
  73. var
  74.   t: DateTime;
  75.   temp: String[10];
  76.   ans: String;
  77. begin
  78.   if dt = 0 then
  79.   begin
  80. {$ifdef GREEK}
  81.     ShowDate := 'âäî êæòôäê';
  82. {$else}
  83.     ShowDate := 'NOT VALID!';
  84. {$endif}
  85.     exit;
  86.   end; { if }
  87.   UnPackTime(dt,t);
  88. {$ifdef GREEK}
  89.   Str(t.Day,temp);
  90. {$else}
  91.   Str(t.Month,temp);
  92. {$endif}
  93.   if Length(temp) = 1 then temp := '0' + temp;
  94.   ans := temp;
  95. {$ifdef GREEK}
  96.   Str(t.Month,temp);
  97. {$else}
  98.   Str(t.Day,temp);
  99. {$endif}
  100.   if Length(temp) = 1 then temp := '0' + temp;
  101.   ans := ans + '/' + temp;
  102.   Str(t.Year,temp);
  103.   ans := ans + '/' + temp;
  104.   ShowDate := ans;
  105. end; { ShowDate }
  106.  
  107. procedure KillTimeIn(var time:Longint);
  108. var
  109.   temp: DateTime;
  110. begin
  111.   UnpackTime(time,temp);
  112.   with temp do
  113.   begin
  114.     hour := 0;
  115.     min := 0;
  116.     sec := 0;
  117.   end; { with }
  118.   PackTime(temp,time);
  119. end; { KillTimeIn }
  120.  
  121. procedure ConvertStrToDate(date:string;var dt:DateTime);
  122. var
  123.   temp,temp2: Byte;
  124.   error: Integer;
  125.   procedure CheckError(value: Word;min,max: Integer);
  126.   begin
  127.     if error <> 0 then
  128.     begin
  129.       Writeln(stderr,'Date conversion error. Not a valid date.');
  130.       Halt(1);
  131.     end; { if }
  132.     if (value < min) or (value > max) then
  133.     begin
  134.       Writeln(stderr,'Not a valid numeric value for MM/DD/YY');
  135.       Halt(1);
  136.     end; { if }
  137.   end; { CheckError }
  138. begin
  139.   ChangeChar(date,sizeof(date),'-','/');
  140.   temp := Index(date,'/',false,1);
  141.   Val(Copy(date,1,temp-1),dt.month,error);  { get MM }
  142.   CheckError(dt.month,1,12);
  143.   temp2 := Index(date,'/',false,2);
  144.   Val(Copy(date,temp+1,temp2-temp-1),dt.day,error); { get DD }
  145.   CheckError(dt.day,1,31);
  146.   Val(Copy(date,temp2+1,Length(date)),dt.year,error); { get YY }
  147.   if (dt.year > 79) and (dt.year < 100) then dt.year := dt.year + 1900;
  148.   if (dt.year < 80) then dt.year := dt.year + 2000;
  149.   CheckError(dt.year,1980,2079);
  150. end; { ConvertStrToDate }
  151.  
  152. var
  153.   path: String;
  154.   mask: String;
  155.   todaysDate: DateTime;
  156.   dayOfWeek: Word;
  157.   compareTime: Longint;
  158.   fileCount: Word;
  159.   tempChar: Char;
  160.   direction: Shortint; { 1 is NEWER, 0 is SAME, -1 is OLDER }
  161.  
  162. { function that's called from TPRecDir }
  163. function List(rec: SearchRec): Boolean; far;
  164. var
  165.   temp: String;
  166. begin
  167.   List := Yes;
  168.   KillTimeIn(rec.time);
  169.   if ((direction =  0) and (rec.time  = compareTime)) or
  170.      ((direction =  1) and (rec.time >= compareTime)) or
  171.      ((direction = -1) and (rec.time <= compareTime)) then
  172.   begin
  173.     Inc(fileCount);
  174.     temp := FExpand(rec.name);
  175.     if AttributeMatches(rec.attr,Directory) then
  176.       temp := temp + ' [DIR]';
  177.     Writeln(Left(temp,60,'.'),' ',ShowDate(rec.time));
  178.   end; { if }
  179. end; { List }
  180.  
  181. begin
  182.   DisplayCopyright;
  183.   CheckArgs;
  184.   fileCount := 0;
  185.   path := ParamStr(1); { get path to search }
  186.   mask := GetMask(path);
  187.   path := GetPath(path);
  188.   tempChar := ' ';
  189.   if ParamStr(2) = '+' then tempChar := '+';
  190.   if ParamStr(2) = '-' then tempChar := '-';
  191.   if (ParamCount < 2) or ((ParamCount = 2) and ((tempChar = '+') or (tempChar = '-'))) then
  192.   begin
  193.     GetDate(todaysDate.year,todaysDate.month,todaysDate.day,dayOfWeek); { get today's date }
  194.     case tempChar of
  195.       '+': direction :=  1;
  196.       '-': direction := -1;
  197.       ' ': direction :=  0;
  198.     end; { case }
  199.   end { if }
  200.   else
  201.   begin
  202.     ConvertStrToDate(ParamStr(2),todaysDate);
  203.     tempChar := ' ';
  204.     if ParamStr(3) = '+' then tempChar := '+';
  205.     if ParamStr(3) = '-' then tempChar := '-';
  206.     case tempChar of
  207.       '+': direction :=  1;
  208.       '-': direction := -1;
  209.       ' ': direction :=  0;
  210.     end; { case }
  211.   end; { else }
  212.   with todaysDate do
  213.   begin
  214.     hour := 0;
  215.     min  := 0;
  216.     sec  := 0;
  217.   end; { with }
  218.   PackTime(todaysDate,compareTime);
  219.   ForEachFileIn(path,mask,AnyFile,True,True,@List);
  220.   Writeln(stderr,fileCount:0,' '+OneManyStr(fileCount,'file/dir','files/dirs')+' found');
  221. end.
  222.